Shareware Grab Bag/Shareware Grab Bag.iso/007/x68000.arc/SOURCE.ARC/LONGNUMB.MOD

Modula Implementation | 1986-03-05 | 8.9 KB | 404 lines

IMPLEMENTATION MODULE LongNumbers;
(* Routines to handle HEX digits for the X68000 cross assembler. *)
(* All but LongPut and LongWrite are limited to 8 digit numbers. *)

   FROM FileSystem IMPORT
      File;

   IMPORT FileSystem;   (* WriteChar *)

   IMPORT Terminal;   (* Write *)

(*---
(* These objects are declared in the DEFINITION MODULE *)

   CONST
      DIGITS = 8;
      BASE = 16;

   TYPE
      LONG = ARRAY [1..DIGITS] OF INTEGER;
                                                    ---*)

   CONST
      Zero = 30H;
      Nine = 39H;
      hexA = 41H;
      hexF = 46H;



   PROCEDURE LongClear (VAR A : LONG);
   (* Sets A to Zero *)

      VAR
         i : CARDINAL;

      BEGIN
         FOR i := 1 TO DIGITS DO
            A[i] := 0;
         END;
      END LongClear;



   PROCEDURE LongAdd (A, B : LONG; VAR Result : LONG);
   (* Add two LONGs, giving Result *)

      VAR
         Carry : INTEGER;
         i : CARDINAL;

      BEGIN
         Carry := 0;
         FOR i := 1 TO DIGITS DO
            Result[i] := (A[i] + Carry) + B[i];
            IF Result[i] >= BASE THEN
               Result[i] := Result[i] - BASE;
               Carry := 1;
            ELSE
               Carry := 0;
            END;
         END;
      END LongAdd;



   PROCEDURE LongSub (A, B : LONG; VAR Result : LONG);
   (* Subtract two LONGs (A - B), giving Result *)

      VAR
         Borrow : INTEGER;
         i : CARDINAL;

      BEGIN
         Borrow := 0;
         FOR i := 1 TO DIGITS DO
            Result[i] := (A[i] - Borrow) - B[i];
            IF Result[i] < 0 THEN
               Result[i] := Result[i] + BASE;
               Borrow := 1;
            ELSE
               Borrow := 0;
            END;
         END;
      END LongSub;



   PROCEDURE CardToLong (n : CARDINAL; VAR A : LONG);
   (* Converts CARDINALs to LONGs *)

      VAR
         i : CARDINAL;

      BEGIN
         LongClear (A);

         i := 1;
         REPEAT
            A[i] := n MOD BASE;
            INC (i);
            n := n DIV BASE;
         UNTIL n = 0;
      END CardToLong;



   PROCEDURE LongToCard (A : LONG; VAR n : CARDINAL) : BOOLEAN;
   (* Converts LONG TO CARDINAL, returns FALSE if conversion impossible *)
      BEGIN
         n := (A[4] * 4096) + (A[3] * 256) + (A[2] * 16) + A[1];
         RETURN ((A[5] = 0) AND (A[6] = 0) AND (A[7] = 0) AND (A[8] = 0));
      END LongToCard;



   PROCEDURE LongToInt (A : LONG; VAR n : INTEGER) : BOOLEAN;
   (* Converts LONG to INTEGER, returns FALSE if conversion impossible *)

      VAR
         TempC : CARDINAL;
         Neg : BOOLEAN;

      BEGIN
         IF (A[5] = 0) AND (A[6] = 0) AND (A[7] = 0) AND (A[8] = 0) THEN
            Neg := FALSE;
         ELSIF (A[5] = 15) AND (A[6] = 15) AND (A[7] = 15) AND (A[8] = 15) THEN
            Neg := TRUE;
         ELSE
            RETURN FALSE;   (* Out of INTEGER range *)
         END;

         TempC := (A[4] * 4096) + (A[3] * 256) + (A[2] * 16) + A[1];
         IF ((TempC <= 32767) AND (NOT Neg)) OR ((TempC > 32767) AND Neg) THEN
            n := INTEGER (TempC);
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END;
      END LongToInt;



   PROCEDURE LongInc (VAR A : LONG; n : CARDINAL);
   (* Increment LONG by n *)

      VAR
         T : LONG;

      BEGIN
         CardToLong (n, T);
         LongAdd (A, T, A);
      END LongInc;



   PROCEDURE LongDec (VAR A : LONG; n : CARDINAL);
   (* Decrement LONG by n *)

      VAR
         T : LONG;

      BEGIN
         CardToLong (n, T);
         LongSub (A, T, A);
      END LongDec;



   PROCEDURE LongCompare (A, B : LONG) : INTEGER;
   (* Returns: 0 if A = B, -1 if A < B, +1 if A > B *)

      VAR
         i : CARDINAL;

      BEGIN
         i := DIGITS;
         WHILE (i > 0) AND (A[i] = B[i]) DO
            DEC (i);
         END;

         IF i = 0 THEN
            RETURN 0;
         ELSIF A[i] < B[i] THEN
            RETURN -1;
         ELSIF A[i] > B[i] THEN
            RETURN +1;
         ELSE
            (* Impossible! *)
         END;
      END LongCompare;



   PROCEDURE GetDigit (n : INTEGER) : CHAR;
   (* Function returning HEX character corresponding to digit *)

      BEGIN
         IF (n >= 0) AND (n <= 9) THEN
            RETURN CHR (CARDINAL (n) + Zero);
         ELSIF (n >= 10) AND (n <= 15) THEN
            RETURN CHR ((CARDINAL (n) - 10) + hexA);
         ELSE
            RETURN '*';
         END;
      END GetDigit;



   PROCEDURE LongPut (VAR f : File; A : ARRAY OF INTEGER; Size : CARDINAL);
   (* Put LONG number in FILE f *)

      VAR
         i : CARDINAL;

      BEGIN
         IF Size = 0 THEN
            RETURN;
         END;

         DEC (Size);   (* adjust for zero-based array *)
         IF Size > HIGH (A) THEN
            Size := HIGH (A);
         END;

         FOR i := Size TO 0 BY -1 DO
            FileSystem.WriteChar (f, GetDigit (A[i]));
         END;
      END LongPut;



   PROCEDURE LongWrite (A : ARRAY OF INTEGER; Size : CARDINAL);
   (* Write LONG number to console screen *)

      VAR
         i : CARDINAL;

      BEGIN
         IF Size = 0 THEN
            RETURN;
         END;

         DEC (Size);
         IF Size > HIGH (A) THEN
            Size := HIGH (A);
         END;

         FOR i := Size TO 0 BY -1 DO
            Terminal.Write (GetDigit (A[i]));
         END;
      END LongWrite;



   PROCEDURE IsHEX (c : CHAR) : BOOLEAN;
   (* checks if c is one of 0..9, A..F *)

      VAR
         C : CARDINAL;

      BEGIN
         C := ORD (CAP (c));

         RETURN (((C >= Zero) AND (C <= Nine)) OR
                 ((C >= hexA) AND (C <= hexF)));
      END IsHEX;



   PROCEDURE GetHEX (c : CHAR) : INTEGER;
   (* returns HEX value of character *)

      VAR
         C : CARDINAL;

      BEGIN
         C := ORD (CAP (c));
         IF C < hexA THEN
            RETURN INTEGER (C - Zero);
         ELSE
            RETURN 10 + INTEGER (C - hexA);
         END;
      END GetHEX;



   PROCEDURE StringToLong (S : ARRAY OF CHAR; VAR A : LONG) : BOOLEAN;
   (* Converts a string (in HEX) into a LONG *)

      VAR
         i, j : CARDINAL;

      BEGIN
         LongClear (A);

         IF S[0] # '$' THEN
            RETURN FALSE;   (* not a HEX string *)
         ELSE
            j := 1;
            WHILE (IsHEX (S[j])) AND (j <= DIGITS) DO
               INC (j);
            END;

            DEC (j);   (* gone too far, so back up one *)
            i := 1;
            WHILE j > 0 DO
               A[i] := GetHEX (S[j]);
               INC (i);   DEC (j);
            END;

            IF A[i - 1] > 7 THEN   (* sign extend *)
               FOR j := i TO DIGITS DO
                  A[j] := 15;
               END;
            END;
            RETURN (i > 1);
         END;
      END StringToLong;



   PROCEDURE BinStrToLong (S : ARRAY OF CHAR; VAR A : LONG) : BOOLEAN;
   (* Converts a string (in Binary, maximum of 16 digits) into a LONG *)

      CONST
         MAXBit = 16;

      VAR
         Bin, i : CARDINAL;
         Neg : BOOLEAN;

      BEGIN
         IF S[0] # '%' THEN
            RETURN FALSE;
         END;

         IF S[1] = '1' THEN
            Neg := TRUE;
         ELSE
            Neg := FALSE;
         END;

         Bin := 0;
         i := 1;
         WHILE S[i] # 0C DO
            IF i > MAXBit THEN
               RETURN FALSE;
            END;
            Bin := Bin * 2;
            IF S[i] = '0' THEN
               (* No Action Needed *)
            ELSIF S[i] = '1' THEN
               Bin := Bin + 1;
            ELSE   (* Not a valid binary digit *)
               RETURN FALSE;
            END;
            INC (i);
         END;

         CardToLong (Bin, A);

         IF Neg THEN   (* sign extend *)
            i := DIGITS;
            WHILE A[i] = 0 DO
               A[i] := 15;
               DEC (i);
            END;
            IF A[i] < 8 THEN
               IF A[i] < 4 THEN
                  IF A[i] < 2 THEN
                     A[i] := A[i] + 2;
                  END;
                  A[i] := A[i] + 4;
               END;
               A[i] := A[i] + 8;
            END;
         END;

         RETURN TRUE;
      END BinStrToLong;



   PROCEDURE AddrBoundL (VAR A : LONG);
   (* Forces A to a long word boundary *)
      BEGIN
         WHILE NOT (CARDINAL (A[1]) IN {0, 4, 8, 12}) DO
            LongInc (A, 1);
         END;
      END AddrBoundL;



   PROCEDURE AddrBoundW (VAR A : LONG);
   (* Forces A to a word boundary *)
      BEGIN
         WHILE NOT (CARDINAL (A[1]) IN {0, 2, 4, 6, 8, 10, 12, 14}) DO
            LongInc (A, 1);
         END;
      END AddrBoundW;

END LongNumbers.